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ABSTRACT 

EMPLEB,  written  for  use  on  a  CDC  6000  computer  operating  under 
Scope  3,  is  a  librarian  program  whose  function  is  to  maintain  an  active 
library  and  a  separate  permanent  archive  of  program  UPDATE  and 
object  files  on  a  sequential  storage  device  such  as  a  magnetic  tape  reel. 
The  EMPLIB  librarian  can  perform  readout  or  alteration  of  the  library 
or  archive,  and  also  certain  file-positioning  actions  and  program  object 
file  editing. 
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1.  INTRODUCTION 


EMPUB  Is  a  p)  -  vritten  in  CDC  Fortran  Extended  and  Compass  for  use  on  CDC 
6000-serios  computers  ..  mating  under  Scope  3.  It  has  been  tested  and  run  under  Scopes  3.2 
and  3.3,  and  requires  abc  A  54,200  words  (octal)  to  load  and  execute.  EMPUB  is  a  librarian 
program  whose  function  is-to  maintain  a  library  of  frequently  used  program  UPDATE  flies 
(called  "source"  files  here)  and  program  object  files  (called  "binary"  files  here,  i.e.,  the 
compiler  or  assembler  object  out*<ut).  The  term  "file"  is  defined  here  as  a  string  of  data 
terminated  by  an  EOF.  The  library  is  kept  on  a  magnetic  tape  or  other  permanent  sequential 
data  storage  device.  EMPUB  also  maintains  an  archive  magnetic  tape  of  program  source  or 
binary  files  to  be  saved  indefinitely.  The  user  may  run  the  librarian  program  EMPUB  and 
cause  it  to  perform  certain  library  or  archive  functions  by  placing  directive  cards  in  the  in¬ 
put  card  stream  to  be  read  by  the  librarian.  These  directive  cards  are  processed  sequentially, 
allowing  library  alteration,  program  file  readout,  user -assigned  filenames  for  readin  and 
readout  functions,  certain  filename  actions  such  as  rewind,  endfile,  and  skipfile,  and  archive 
additions  or  readout.  The  term  "filename"  is  defined  here  as  a  logical  file  name  (i.e.,  LGO, 
TAPE1,  OLDPL,  etc.). 

2.  THE  LIBRARIAN 

The  librarian  uses  nine  working  filenames  for  various  functions.  All  functions  but  one 
are  assigned  a  one-  or  two-letter  mnemonic  and  are  associated  by  default  with  certain  file¬ 
names  which  may  be  altered  by  the  user  during  execution  of  the  librarian.  The  file  functions, 
mnemonics,  default  filenames,  and  purpose  are  listed  below: 


Function 

Mnemonic 

Filename 

Purpose 

card  input 

I 

INPUT 

Contains  EMPUB  directives. 

print  output 

O 

OUTPUT 

Contains  printed  output. 

library 

L 

EMPUB 

Contains  he  program  library. 

archive 

A 

ARCHIV 

Contains  -.he  program  archive. 

source  input 

SI 

NEWPL 

Source  filas  raid  from  NEWPL. 

source  output 

SO 

OLDPL 

Source  files  written  to  OLDPL. 

Unary  input 

BI 

LGO 

Binary  files  read  from  LGO. 

binary  output 

BO 

XQT 

Binary  files  written  to  XOT. 

scratch 

none 

TAPE40 

Seratct  file  for  librarian. 

All  of  the  file  functions,  with  the  exception  of  the  scratch  function,  may  be  assigned  dif¬ 
ferent  filenames  by  use  of  the  FILES  directive  described  later.  The  filenames  accessed  by 
the  librarian  must  all  be  odd-parity  files  as  distinct  from  even-parity  BCD  files.  The  librarian 
can,  of  course,  access  an  odd  parity  file  onto  which  a  BCD  file  has  been  copied.  The  terms  file 
and  binary  file  as  used  here  both  refer  to  files  with  odd  parity.  The  difference  between  the  two 
types  of  files  is  one  of  name  only,  and  is  conventionalized  so  that  program  UPDATE  files  are 
designated  as  source  files  and  program  object  files  are  designated  as  binary  files.  The  direc¬ 
tives  SELECT  and  REFUSE  work  properly  only  with  binary  files  that  are,  in  fact,  program 
object  files.  Otherwise,  any  data  file  may  be  treated  as  a  program  source  or  binary  file  and 
manipulated  by  the  librarian.  The  first  file  on  the  library  filename  is  intended  to  be  the  li¬ 
brarian  program  object  file,  where  it  may  be  easily  copied  off  and  executed.  (If  the  library 
tape  is  executed  directly,  the  system  loader  will  unload  the  tape,  preventing  later  access  to 
the  library.)  The  second  file  contains  a  table  of  the  library  conte  its.  Subsequent  files  are 
source  and  binary  files  previously  placed  in  the  library.  Each  file  is  identified  in  the  table  of 
contents  by  a  name  identifier,  a  version  identifier,  a  mode  identifier  (to  distinguish  whether 
it  is  a  source  file  or  a  binary  file),  and  date  of  entry  into  the  library.  The  name  and  version 
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Idontifiors  must  bo  from  ono  to  ton  character*  with  no  Imboddod  blank*  or  oommu,  Tha 
version  IdonUflor  1*  optional  and  will  be  all  blank#  if  not  apadflad  by  tha  uaar.  Tha  archive 
fllenaroo  contain*  two  data  file*  for  each  source  or  binary  file  leapt  on  it.  The  first  is  a  file 
containing  the  table  of  contents  information  about  the  source  or  binary  file,  and  the  second 
data  file  Is  the  source  or  binary  file  itself.  The  end  of  the  archive  is  denoted  by  a  file  con¬ 
taining  Just  the  ono  word  "LAST." 


3.  LIBRARIAN  DIRECTIVES 

The  various  functions  the  librarian  can  perform  will  be  illustrated  through  their  use  in 
tho  following  examples.  The  completed  output  is  listed  in  Appendix  A.  It  is  assumed  In  the 
first  example  that  the  librarian  object  fils  has  been  copied  to  the  filename  EMPI2B  (so  as  to 
allow  creation  of  the  library)  and  that  a  magnetic  tape  haa  been  aasigned  to  the  filename 
ARCHTV.  Execution  of  the  librarian  cauaes  the  filename  EMPUB  to  be  rewound  If  the  first 
directive  is  not  a  FILES  directive;  thus  the  library  filename  must  be  changed  immediately  if 
It  la  not  to  be  EMPUB. 

Directives  are  froe-fleld,  but  must  have  a  dollar  sign  in  oolumn  one.  Directives  and 
identifiers  must  be  separated  by  blanks,  unless  oommaa  are  required.  The  librarian  will 
copy  each  directive  card  to  the  print  file  as  encountered  and  then  add  a  description  of  any 
action  taken.  On  the  print  file,  directives  can  be  recognised  by  the  single  dollar  sign,  whereas 
statements  originated  by  the  librarian  begin  with  "EMPUB  $$$." 


3.1  CREATE 

CREATE  causes  a  library  to  be  created  on  the  filename  attached  to  the  library  ftmetion. 
Physically,  the  first  file  is  skipped  on  the  library  filename  and  a  table  cf  contents  file  is  write 
ten  which  records  the  first  file  as  "EMPUB"  and  the  second  file  as  "TOC."  The  library  must 
bo  created  (establishing  a  table  of  contents)  before  any  library  additions  can  be  performed.  In 
fact,  a  table  of  contents  is  required  by  all  but  the  following  directives:  CREATE,  CREATE- 
ARCH,  FILE8,  SKIP,  SKIPB,  HISTORY,  ENDFILE,  REWIND,  FIND,  AND  FINDB.  The  direc¬ 
tives  SELECT  and  REFUSE  may  or  may  not  require  a  table  of  oontents.  fCREATE 


3.2  CREATEARCH 

CREATEARCH  causes  an  archive  to  be  established  on  the  filename  attached  to  tha  archive 
function.  Physically,  the  hollerlth  word  "LAST"  is  written  on  the  archive.  The  archive  must 
bo  established  before  any  archive  additions  can  be  performed.  The  archive  la  rewound  before 
and  after  the  creation.  fCREATEARCH 


3.3  End  of  librarian  Input 

The  sequence  of  directives  is  terminated  by  a  7-8-9  card.  If  tha  last  operation  on  the 
source  output  or  binary  output  filename  was  a  write-end-of-reoord,  the  fllaMina  Is  EOF*d 
and  backspaced  before  execution  la  ended.  All  the  following  directives  may  be  given  ta  the 
same  or  any  subsequent  execution  of  the  librarian  once  tbs  library  haa  bean  created.  Tha 
file  name/versions  specified  must  be  in  tha  library  when  the  directive  la  processed  by  fee 
librarian,  except  for  new  name/vereions  In  ADD  (ADDB)  and  RENAME  (RENAMED),  and 
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except  for  the  archive  directive  FIND  (FINDB).  File  name/versions  appearing  with  the  FIND 
(FINDB)  directive  must  already  be  on  the  archive  when  the  directive  is  processed.  - 


3.4  ADD  and  ADDB 

ADD  ttr DB)  causes  the  source  (binary)  file  on  the  source  (binary)  input  filename  to  be 
added  to  ine  library,  and  assigns  it  to  the  name  and  version  specified.  The  source  (binary) 
input  filename  is  rewound  before  reading  is  begun,  unless  suppressed  by  a  NOREWIND 
directive  (discursed  later).  $ADD  PROG  VERS 


3.5  TOC 

TOC  causes  a  table  of  contents  of  the  library  to  be  printed.  $TOC 


3.6  FILES 

FILES  causes  the  file  functions  whose  mnemonics  are  specified  on  the  directive  card  to 
be  reassigned  different  filenames.  A  reassignment  consists  of  the  mnemonic,  one  or  more 
blanks,  and  the  new  filename,  in  that  order.  Multiple  reassignments  must  be  separated  by 
commas.  Old  filenames  whose  last  operation  was  a  write-end-of-record  are  EOF'd  and  back¬ 
spaced  before  being  detached  from  a  file  function  when  the  reassignment  is  made.  This 
directive  may  be  issued  even  if  the  library  has  not  been  created.  $FILES  SI  OLD,  BI  AGO, 

SO  NEW 


3.7  SKIP  and  SKIPB 

SKIP  (SKIPB)  causes  the  number  of  files  specified  to  be  skipped  in  a  forward  direction  on 
the  source  (binary)  input  filename.  Up  to  999  files  may  be  slipped  with  one  directive.  If  the 
number  of  files  to  be  skipped  is  not  specified,  one  file  is  skipped.  $SKIPR  2 


3.8  NOREWIND 

NOREWIND  suppresses  the  automatic  rewind  of  the  source  (binary)  input  filename  for 
the  next  (and  only  the  next)  ADD  (ADDB)  or  CHANGE  (CHANGEB)  directive  encountered. 
INOREWIND 


3.9  CHANGE  and  CHANGEB 

CHANGE  (CHANGEB)  causes  the  source  (binary)  file  name/version  specified  to  be  re¬ 
placed  on  the  library  by  the  next  file  encountered  on  the  source  (binary)  input  filename.  The 
filename  is  automatically  rewound  before  reading  unless  suppressed,  as  in  this  example,  by 
a  NOREWIND  directive.  The  present  data  is  placed  in  the  library  table  of  contents  for  the 
file  changed.  The  file  changed  must  already  be  in  the  library.  $CHAKGE  PROG  VERS 


3.10  RENAME  and  RENAMEB 

RENAME  (RENAMEB)  causes  the  first  source  (binary)  file  name/version  given  on  the 
card  to  be  renamed  in  the  table  of  contents  file  with  the  second  source  (binary)  file  name/ 
version  given  on  the  card.  The  first  and  second  file  name/version  must  be  separated  by  a 
comma.  ^RENAME  PROG  VERS,  PROGA  NEWNAME 


3.11  DROP  and  DROPB 

DROP  (DROPB)  causes  the  source  (binary)  file  name/version  to  be  removed  from  the 
library  and  its  entry  in  the  table  of  contents  file  to  be  deleted.  The  first  file  on  the  library 
(the  EMPUB  binary  file)  will  never  be  dropped,  since  this  will  cause  the  library  to  be 
scrambled.  $DROP  NEWPROG 


3.12  KEEP  and  KSEPB 

KEEP  (KEEPB)  causes  the  source  (binaiy)  file  name/version  specified  to  be  added  to 
the  archive.  The  specified  file  name/version  must  already  be  in  the  library.  Once  added  to 
the  archive,  a  file  cannot  be  removed  from  the  archive  by  the  librarian.  $  KEEPB  PROG 
VERS 


3.13  HISTORY 

HISTORY  causes  the  contents  of  the  archive  to  be  scanned  and  a  list  of  the  file  name/ 
versions  encountered  to  be  printed.  This  directive  may  be  processed  by  the  librarian  even 
if  the  library  has  not  been  created;  only  the  archive  need  exist.  ^HISTORY 


3J.4  RUN 

RUN  causes  the  first  binary  file  on  the  library  with  the  specified  name  to  be  copied  to  the 
binary  output  filename  irrespective  of  the  program  version.  Thus,  only  the  program  name 
need  be  specified.  The  terminating  EOF  is  not  copied,  so  further  material  may  be  copied  to 
the  binary  filename  to  complete  the  desired  load  module.  $RUN  PROG 


3.15  COPY  and  COPYB 

COPY  (COPYB)  causes  the  source  (binary)  file  name/version  specified  on  the  library  to 
be  copied  to  the  source  (Unary)  output  filename.  The  terminating  EOF  is  not  copied,  just  as 
for  the  RUN  directive.  $COPY  PROGA  NEWNAME 


3.16  SELECT 

SELECT  causes  the  specified  binary  file  name/version  on  the  library  to  be  scanned  for 
the  named  object  programs  or  subprograms,  which  are  copied  as  encountered  to  the  binary 
output  filename  with  no  terminating  EOF.  On  the  directive  card  the  binary  file  name/version 
must  be  the  first  identifiers  after  the  SELECT  word,  followed  by  a  comma,  and  then  followed 
by  the  program  or  subprogram  names  separated  by  commas.  If  the  file  name/veroion  is 
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omitted  so  that  the  next  non-black  character  after  the  directive  is  a  comma,  the  next  file  on 
the  binary  input  filename  will  be  scanned  for  the  named  programs  and  subprograms;  tnis  ac¬ 
tion  does  not  require  a  table  of  contents.  If  the  Inst  non-blank  character  on  the  card  is  a 
comma,  continuation  cards  will  be  read  until  the  final  non-blank  card  character  is  not  a  comma. 
Continuation  cards  must  not  contain  a  dollar  sign  in  column  one,  and  must  contain  information 
in  columns  one  through  79  only.  Up  to  100  program  or  subprogram  names  may  be  specified  in 
the  directive.  A  list  of  all  object  routines  encountered  and  their  selection  or  refusal  is 
printed.  The  largest  object  routine  that  can  be  processed  by  SELECT  or  REFUSE  must  be 
less  than  6000  words  long.  A  statement  of  the  maximum  size  processed  is  printed  at  end  of 
execution.  $SELECT  PROG  VERS,  ISO,  SPLITR,  SPLT1C. 

$SELECT,  ISO,  SPLITR,  SPLITC. 

3.17  REFUSE 

REFUSE  causes  the  same  action  as  SELECT,  except  that  specified  object  program  and 
subprogram  names  are  not  copied  to  the  binary  output  filename  and  all  others  encountered 
are  copied.  Empty  records  are  not  copied.  Up  to  100  names  may  be  specified  for  re¬ 
fusal.  If  the  file  name/version  is  omitted,  the  binary  input  filename  will  be  processed 
instead.  $REFUSE  PROG  VERS,  ISO,  SPLITR,  SPLITC 

3.18  ENDFILE 

END  FILE  causes  the  file  function  whose  mnemonic  is  specified  to  have  an  EOF  written 
on  the  filename  assigned  to  the  file  function.  Only  one  file  function  may  he  specified  on  the 
directive  card  and  only  the  file  functions  BO  and  SO  may  be  endfiled  with  this  directive. 

$  ENDFILE  EC 

3.19  REWIND 

REWIND  causes  the  file  function  whose  mnemonic  is  specified  to  have  it3  assigned  file¬ 
name  rewound.  If  information  had  been  written  to  the  filename,  end-of-informatton  termina¬ 
tors  are  written  to  the  filename  before  it  is  rewound.  The  file  functions  1,0,  and  L  cannot  be 
rewound  with  this  directive.  $REWIND  SO 

3.20  FIND  and  FINDB 

FIND  (FINDB)  causes  the  archive  to  be  searched  for  the  source  (binary)  file  name/ 
version  specified,  which  is  then  copied  to  the  source  (binary)  output  filename.  No  EOF  is 
written,  just  as  for  the  COPY  (COPYB)  directive.  The  directives  FIND  and  FINDB  may  be 
processed  by  the  librarian  even  if  the  library  has  not  been  created;  only  the  archive  is  re¬ 
quired  to  exist.  $F1KDB  PROG  VERS 

3.21  REPLACE  and  REPLACES 

REPLACE  (REPLACEB)  causes  the  source  (binary)  file  name/version  specified  to  be 
replaced  on  the  library  on  the  next  file  encountered  on  the  source  (binary)  input  filename, 
and  given  a  new  name/version  label.  This  combines  the  functions  of  CHANGE  (CHANGEB) 
and  REPLACE  (REPLACEB).  The  directive  format  is  the  same  as  for  the  RENAME 
(RENAMEB)  directive.  The  source  (binary)  input  filename  is  rewound  before  reading  is 
begun,  unless  suppressed  by  a  NOREWIND  directive. 

4.  LIBRARIAN  ERROR  MESSAGES 

When  the  librarian  detects  an  error  involving  the  directive  card  being  processed,  a  mes¬ 
sage  describing  the  nature  of  the  error  5s  printed  and  the  rest  of  the  librarian  card  input  file 
is  copied  to  the  prist  output  file,  after  which  execution  is  terminated  by  a  call  to  the  nonexist¬ 
ent  subroutine  ABORT  which  causes  a  mode  one  (address-out-of-range)  error  termination. 
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Terminators  are  assured  to  be  on  any  source  or  binary  output  filename  if  the  filename  has 
been  written  on,  just  as  for  a  normal  termination. 

If  another  kind  of  error  is  detected,  an  informative  message  is  printed  and  execution  is 
terminated  immediately  with  a  CALL  ABORT.  Terminators  are  not  assured  for  filenames 
assigned  to  output  functions  at  the  time  the  error  was  detected. 


4.1  Diroctive  format  errors 

The  following  errors  use  the  ABORT  termination  after  checking  file  terminators: 

1.  Missing  or  misplaced  dollar  sign  on  directive  card.  The  dollar  sign  must  be  in 
column  one. 

2.  Improper  directive.  A  directive  csnnot  be  found  on  the  card. 

3.  Unrecognizable  directive.  The  specified  directive  is  not  familiar  to  the  librarian. 

4.  Directive  requi.es  a  table  of  contents.  The  specified  directive  requires  a  created 
library  when  none  exists. 

5.  Missing  program  filename.  A  program  file  name  cannot  be  found  on  the  card  when 
gd«>  is  required. 

6.  Program  file  name  too  long.  The  specified  program  file  name  is  longer  than  10 
characters. 

7.  Program  file  version  too  long.  The  specified  program  file  version  is  longer  than 
10  characters. 

8.  Progrs  .1  file  name/version  not  in  table  of  contents.  The  specified  name/version  is 
not  on  the  library  and  the  directive  cannot  be  executed. 

9.  Adding  file  already  in  table  of  contents.  The  specified  name/version/mode  :s  already 
in  the  library;  a  unique  name/version/mode  must  be  specified. 

10.  Missing  comma.  A  needed  comma  is  missing  between  the  old  name/version  and  file 
new  name/version  on  a  RENAME,  RENAMES,  REPLACE,  or  REPLACEB  directive. 

11.  Word  is  too  long.  A  word  is  longer  than  10  characters  on  a  FILES  directive  card. 

In  fact,  SCOPE  can  handle  filenames  only  up  to  seven  characters  long,  so  care  should 
be  taken  not  to  use  8,  9,  or  10  character  filenames. 

12.  Unrecognized  file  type.  The  file  function  type  specified  is  not  recognized. 

13.  More  than  100  record  names.  Too  many  program  and  subprogram  names  are  listed 
in  a  SELECT  or  REFUSE  directive. 

14.  Illegal  file  type.  A  file  function  type  cannot  be  found  on  the  diroctive  card. 


15.  Illegal  directive  for  the  file  type.  The  directive  is  not  allowed  for  the  file  function 
type  specified. 


16.  Illegal  number.  Unrecognizable  number  on  a  SKIP  or  SKIPB  card;  999  is  the  maxi¬ 
mum  allowed. 

17.  Program  file  name/version  not  on  archive.  The  name/version  specified  by  a  FIND 
or  F1NDB  directive  is  not  in  the  archive. 


4.2  Other  errors 

The  following  errors  cause  an  immediate  CALL  ABORT  U-  mination; 

1.  KEEP  read  parity  error.  A  read  parity  error  occurred  while  reading  the  library 
for  a  KEEP  or  KEET'B  directive. 

2.  KEEP  write  parity  error.  A  write  parity  error  occurred  while  writing  to  the  archive 
for  a  KEEP  or  KEEPB  directive.  The  former  contents  of  the  archive  are  intact,  but 
an  eud-of-archive  record  no  longer  exists. 

3.  FIND  read  error.  A  read  parity  error  occurred  while  reading  the  archive  for  a 
FIND  or  F1NDB  directive. 

4.  HISTORY  read  error.  A  read  parity  error  occurred  while  reading  the  archive  for  a 
HISTORY  directive. 

5.  GETTOC  parity  error.  A  read  parity  error  occurred  while  the  librarian  was  trying 
to  read  the  table  of  contents  file. 

6.  Empty  file.  The  filename  specified  as  file  location  of  a  program  file  was  empty. 

7.  CPYFIL  read  parity  error.  A  read  parity  error  occurred  while  the  librarian  was 
skipping  a  file. 

8.  I/O  error  in  CPYBUF.  An  I/O  error  occurred  while  the  librarian  was  copying  a 
file. 

9.  End-of-information  encountered.  An  EOI  was  encountered  while  trying  to  copy  a 
file;  i.e.f  the  filename  was  short-terminated. 

10.  TOC  writ  s  parity  error  in  NEWFIL.  A  write  parity  error  occurred  while  the  librarian 
was  writing  the  table-of-  contents  file  to  the  library  for  a  library  alteration  directive. 

11.  Read  error  in  CPYREC.  A  read  parity  error  occurred  while  the  librarian  was  read¬ 
ing  or  binary  input  filename  during  processing  of  a  SELECT  or  REFUSE  directive. 

12.  Write  error  in  CPYREC.  A  write  parity  error  occurred  while  the  librarian  was 
copying  a  program  or  subprogram  record  to  the  binary  output  filename  during 
processing  of  a  SELECT  or  REFUSE  directive. 


5.  USER  HINTS 


The  following  information  will  be  useful  to  the  EMPLIB  user. 
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5.1  list  of  directives 


PROG  and  PROGA  ere  program  file  names,  and  VERS  and  VERSA  are  program  file  ver¬ 
sions  in  the  following  examples.  Items  enclosed  in  parenthesis  are  optional.  An  asterisk  de¬ 
notes  the  file  is  rewound  before  reading  unless  suppressed  by  a  NOREWIND  directive. 


Input 

Output 

Directive 

L 

L 

$CREATE 

A 

(CREATEARCH 

SI* 

L 

$ADD  PROG  \VERS) 

BI* 

L 

$ADDB  PROG  (VERS) 

L 

$TOC 

$F1LES  BI  ABC,  A  PQR7826 

SI 

$SKEP  (5) 

BI 

SSKTPB  (399) 

$NOREWIND 

SI* 

L 

(CHANGE  PROG  (VERS) 

HI* 

L 

$CHANGEB  PROG  (VERS) 

L 

L 

$RENAME  PROG  (VERS),  PROGA  (VERSA) 

L 

L 

$RENAMEB  PROG  (VERS),  PROGA  (VERSA) 

L 

L 

(DROP  PROG  (VERS) 

L 

L 

$DROPB  PROG  (VERS) 

L 

A 

(KEEP  PROG  (VERS) 

L 

A 

$KEEPB  PROG  (VERS) 

A 

(HISTORY 

L 

BO 

$RUN  PROG 

L 

SO 

$COPY  PROG  (VERS) 

L 

BO 

(COPYB  PROG  (VERS) 

L 

BO 

(SELECT  PROG  (VERS),  SURA,  SUBB,  SUBC 

BI 

BO 

(SELECT,  SUBA,  SUBB,  SUBC 

L 

BO 

(REFUSE  PROG  (VERS),  SUBA,  SUBB,  SUBC 

BI 

BO 

(REFUSE,  SUBA,  SUBB,  SUBC 

BO  or  SO 

(ENDFILE  BO 

All  but  I,0,L 

(REWIND  SI 

A 

SO 

(FEND  PROG  (VERS) 

A 

BO 

(FENDB  PROG  (VERS) 

SI* 

L 

(REPLACE  PROG  (VERS),  PROGA  (VERSA) 

SI* 

L 

(REPLACEB  PROG  (VERS),  PROGA  (VERSA) 

All  directives  except  CREATE  which  use  the  library  (L)  as  input  or  output  require  a 
created  library.  All  directives  except  CREATEARCH  which  use  the  archive  (A)  as  input  or 
output  require  a  created  archive. 

5.2  File  Actions 

Hie  librarian  checks  the  first  directive  encountered  and,  if  it  is  not  FILES  directive,  re¬ 
winds  the  library  (which  has  the  filename  EMPLIB)  and  looks  to  see  if  a  table  of  contents 
exists.  If  it  is  a  FILES  directive,  rewinding  the  library  file  is  deferred  to  just  prior  to  process¬ 
ing  the  next  directive. 

All  directives  which  use  the.  library  as  output  cause  the  entire  library  to  be  copied  to  the 
scratch  filename  TAPE40  and  recopted  in  its  modified  form  bade  to  the  library  filename.  If 
the  library  is  of  substantial  length  and  if  more  than  one  or  two  directives  of  this  kind  are  to 


be  processed,  much  PP  time  will  be  saved  if  the  library  tape  is  copied  to  a  disk  filename  be¬ 
fore  librarian  execution  and  then  recopied  from  the  disk  filename  back  to  the  library  tape  after 
librarian  execution.  The  library  filename  must  be  the  disk  filename,  of  course.  This  also 
helps  protect  the  library  tape  from  write  parity  errors. 

A  good  practice  is  periodically  to  copy  the  entire  library  and  the  antire  archive  to  a  back¬ 
up  library  tape  and  a  backup  archive  tape,  to  avoid  loss  of  program  files  if  the  first-line 
copies  are  impaired  by  permanent  parity  errors. 

If  the  library  is  of  short  length,  it  may  be  practical  to  have  the  library  reside-  on  a 
permanent  disk  file  instead  of  on  a  magnetic  tape.  The  archive  will  generally  be  too  large 
for  this,  however. 


5.3  Examples  of  usage 

Although  it  would  not  be  possible  to  illustrate  all  the  possible  uses  of  file  EMPLIB  li¬ 
brarian,  a  few  examples  will  be  useful  to  convey  the  flexibility  and  simplicity  of  the  program. 
The  examples  are  for  a  Scope  3.3  system.  All  TOC  directives  are  optional,  but  are  recom¬ 
mended. 


1.  Update,  compilation  of  changes,  and  execution. 

JOB,  CM54000,  TP1 

REQUEST,  EMPLIB.  (540/NOR1N G) 

COPYBF  (EMPLIB,  LIB,  1) 

LIB. 

RETURN  (EMPLIB) 

UPDATE  (P) 

FTN  (I=COMPLE) 

REWIND  (XQT) 

COPYBF  (XQT,  LGO,  1) 

LOO. 

7-8-9 

$TC-~‘ 

$COPY  NEPHI  CORRQ 

^REFUSE  NEPHI  CORRQ,  PHOTON,  GROUND 
7-8-9 

(Update  input  with  changes  for  subroutines  PHOTON  and  GROUND.) 

7-8-9 

(Input  data.) 

6- 7-8-9 

This  could  also  be  accomplished  by  the  following  cards  between  the  FTN  card  and  UP¬ 
DATE  input  cards: 


LOO. 

7-8-9 


STOC 

$FILES  BO  LGO 

5COPY  NEPHI  CORRQ 

IREFUSE  NEPHI  CORRQ,  PHOTON,  GROUND 

7-8-9 
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2.  Update,  compilation  of  changes,  and  alteration  of  library, 


JOB,  CM54000,  TP1. 

REQUEST,  EMPLIB  (540/RING) 

COPYBF  (EMPLIB,  LIB,  1) 

LIB. 

UPDATE  (P,  N,  W)  (W  makes  new  UPDATE  library  sequential.) 
FTN  (I  =  COMPILE) 

LIB. 

UNLOAD  (EMPLIB) 

.-8-9 

$TOC 

$COPY  NEPHJ.  CORRQ 
$FILES  BO  LGO 

SREFUSE  NEPHI  CORRQ,  PHOTON,  GROUND 
7-8-9 

(Update  mput  with  changes  for  subroutines  PHOTON  and  GROUND.) 
7-8-9 

$DROP  NEPHI  CORRQ 
$DROPB  NEPHI  CORRQ 
$ADD  NEPHI  CORRR 
$ADDB  NEPHI  CORRR 
$TOC 
6-7-8-9 


More  efficient  use  of  the  greater  speed  of  disk  files  would  be  made  by  using  the 
following  control  cards  in  the  previous  example: 


JOB  CM54000,  TP1. 

REQUEST,  ZAP.  (540/RING) 

COPYBF  (ZAP,  EMPLIB,  100)  (less  than  100  files  on  ZAP) 
EMPLIB. 

UPDATE  (P,N,W) 

FTN  (I  =  COMPILE) 

EMPLIB. 

REWIND  (EMPLIB,  ZAP) 

COPYBF  (EMPLIB,  ZAP,  LGO) 

UNLOAD  (ZAP) 

7-8-9 


3.  Execution  of  one  program. 

JOB,  CM54000,  TP1. 

REQUEST,  EMPLIB  (540/NORING.) 
COPYBF  (EMPLIB,  LIB,  1) 

LIB. 

RETURN  (EMPLIB) 

RFL.100000. 

REDUCE. 

XQT. 

7-8-9 

$RUN  NEPHI 
7-8-9 
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(Input  data  for  NEPHI.) 
6-7-S-9 


4.  Execution  of  several  programs. 

JOB,  CM54000,  TP1. 

REQUEST,  EMPLIB  (540/NORING.) 
COPYBF  (EMPLIB,  LIB,  1) 

LIB. 

RETURN  (EMPLIB) 

XQT. 

NEXT. 

LAST. 

7-8-9 

$TOC 

$COPYB  PROG  FIRST 
$FILES  BO  NEXT 
$RUN  PROGSEC 
$  FILES  BO  LAST 
$RUN  PROGFIN 
7-8-9 

(Data  for  PROG/FIRST.) 

7-8-9 

(Data  for  PROGSEC.) 

7-8-9 

(Data  for  PROGFIN.) 

6- 7-8-9 
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PROGRAM  EMPLia(XGT,uLaPL,LGO,EMPLIB=4QQ0B,ARCHIV,INPUT=lO0OB,OUTPU 
*T=10UOB,NEHPLtTAPE43,TAPEl=XQT,TAPE2=OLOPL,TAPE3=LGO,TAPE4=EHPLI8, 
‘TAPF.5=ARCHIV,TAPE6  =  INPUTtTAPE7=0UTPUT,TAPEB=NEWPL> 

COrtHON  /HXC/HX 
COMMON  //LHAX, A (6000) 

COMMON  /ARGS/NAME, I  VERS, NAMOLD, I VOLQ,NREC,NAMREC  (100)  ,JTOC,LASTF, 
•IARCH 

OIMENSION  CARO(SL) , TOC(4,50) ,HODEt2) 

COMMON  /FIL£S/FILNAH(9),FETS(9),X(1) 

OIMENSION  CHAR(29) 

INTEGER  TOC,OlDATE, OD  ATE , A,  CHAR,  OOL,CARO,FlLNAH 
INTEGER  X.FETS 

OATA  CHAR/3HRUN, 4HC0PT ,5HC0PY3, 6HCHANGE, 7HCHANGEB, 3HA0D, 4HA00B,4H0 
f R0P,5HQR0P9 ,3HTOC ,4HK£tP, 5HKEEP9 ,6HCREATE ,4HFIN0,  5HFIND3,7HHISTORY 
•»  6HRENAME , 7HRENAMEP , 6HREFUSE , 6HSELECT, 5HFILES, 6HREHIN0, 7HEN0FI LE» 
,«HNOR£MINO,‘-HSKIP,5MS<IPB,10HCREAT£ARCH,THREPLACE,8HREPLACEB/,NCHA 
*R/29/ 

OATA  DOL/1HS/,HODE/5HSOURCE,6HBINARY/,LASTH/4HLAST/ 

LMAX=60l)0 

NX  =  0 

N0REW=0 

IFLAG=0 

JTOC=0 

LASTF=0 

IARCH=0 

irs=o 

JCN=0 

IFIRST=3 

call  FTNBIN(0,0) 

CALL  OATE(OOATE) 

CALL  GETFIl 

PRINT  lfDOaTE,FILNAN{i;,FlLNAM(3),FILNAH{2),FXLNAN(B)fFIL«AH(4),F: 
*LNAM(S),FILNAN(7)  ,FILNAH(6) 

1  FORMAT (MEMPLIB  SIS  THE  OATE  IS  ♦,A1B,»  AND  THE  WORK  FILES  ARE*/ 
•10X, •BINARY  OUTPUT  =  ♦,A7,10X, •BINARY  INPUT  =  *,A7,/10X,*SOURCE  0 
•UTPUT  =  *,A7,10X, ♦SOURCE  INPUT  =  ♦,A7/13X,»EMP  LIBRARY  =  *,A7,1 
*0X,*ARCMIVE  KEEP  =  ♦, A7/19X,»EMPLIB  CUTPUT  =  *,A7,10X,»EMPLIB  INP 
«UT  =  »,A7) 

10  CONTINUE 

REAO  2, CARO 

2  FORMAT (30A1) 

IF (EOF (6) . NE.O)  GO  TO  1000 
IF(CARO(l).EO.COL)  GO  TO  20 
PRINT  3 

3  FORMAT (*0EMPLIB  SIS  INVALID  CONTROL  CARO  FOLLOWS,  JOB  WILL  BE  ABOR 
•TEO  AFTER  READING  INPUT  FILE.*) 

IFLAG=1 

?)  PRINT  4, CARO 

4  FORMAT(1HO,«iJA1) 

IF(IFLAG.NE.O)  GO  TO  10 
IF(IFIRST.NE.O)  GO  TO  2500 
1  =  1 

CALL  NEXTWO(CARO(2) ,I,J,K> 

IF(K.NE.O.OR.J.NE.CHBR(21)>  GO  TO  2500 
IFIRSTsl 
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GO  TO  30 
!0  CONTINUE 

IF(JTOC.NE.O)  GO  TO  30 
CALL  GETTOC(TOC,NFILES,JCR) 

IF'JCR.EQ.l.AND.JTOC.EQ.O)  PRINT  17,FILNAM(4) 

FORMAT (•  EMPLIB  StS  TOC  HISSING  ON  *,A7,*.*) 

JTOC=l 

IF(JCR.EQ.l)  JTOC=-l 

REMIND  4 

LASTF=0 

CALL  ISIT  (CHAR,CAR0(2> ,NCHAR, JUMP, IFILE, TOC, OOATE.JCR.FILNAM) 
IF(jJNP-NF..O)  GO  TO  40 
PRINT  19 

FORMAT (•  EMPLIB  III  MILL  ABORT  AFTER  REAOING  INPUT  FILE.*! 

IFLAG=1 
GO  TO  10 
CONTINUE 

GO  TO  (60 ,60,60 ,70,70,80,80,90, 9u,100, 110,110, ISO , 160*160. 210.230, 
'230,240, 240, 10, 10,10,250,260, 260, 270, 200, 200) ,JUhD 
CONTINUE 

CALL  POSFIL(4,LASTF,IFILE) 

K=1 

IF (JUMP. EQ. 2)  Rr2 
CALL  CPTF IL (4 , K,  0) 

LASTF=IFILE 

J=T0C(4,IFILE) 

PRINT  6,IFILE,HOOECJ), (TOC(I.IFILC) , 1-1,3) ,FILNAH(4) , FILNAH(K) 
FORMAT (*  EMPLIB  SIS  COPIED  *,I2,*TM  FILE  l*,A7,3A10,*)  FROM  *,A7»* 

*  TO  * ,A7, •  FILE.*) 

GO  TO  10 
CONTINUE 

CHANGE  ANO  CHANGED 
L=7HCHANG£0 
NAHOLO=TOC (l.IFILE) 

IV0L0=T0C(2,IFILF) 

CONTINUE 

OLOATE*TOC(3, IFILE) 

T0C(3,IFILf)=00ATE 
REMIND  4 
REMIND  40 

CALL  CPTFIL(4,40,NFILES) 

J=0 

IF ( JUMP. EQ. 5. OR. JUMP. EQ. 29)  J=3 
IF (NOREM. EQ.01  REMINO  J 
NOREN=0 

CALL  NEMFIL(NFILES,TOC,IFILE, J) 

LASTFrO 
K=TOC (4, IFILE) 

PRINT  7, L.IFILE, HOOE( Cl ,NAMOLO,IVOLO,OLOATE,HOOE(K) , ( 
•TOC(I,IFILE),I=l,3) ,FILNAM(4) ,FILNAH( J) 

FORMAT (*  EMPLIB  Its  »,A9,  I2,*TH  FILE  (MAS  *,A7,3A10,*,  IS  NON 

•  *,A7,3A1D,*)»/20X,*ON  *,A7,*  USING  CONTENTS  OF  *,A7f*  FILE.*) 

GO  TO  1G 

CONTINUE 
AOD  ANO  AOOB 
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j=a 

IF(JUMP.EQ.7J  J“3 
REMIND  4 
REMIND  40 

IF(NOREH.Ea.O)  REMIND  J 
NOREM=0 

CALL  CPYFIL(4,40,SF1L£S> 

NFILE3=IF ILE 

CALL  NEMFIL (NFIL£S,TOC ,NFIL£S , J> 

LASTF=0 

K=T0C(4, IFILE) 

PRINT  8, IFILE, MODE (K> ,(TOC(I, IFILE) ,1=1,3), FILNAM(4),FILNAN(J) 

3  FORMAT (*  EfPLIB  SSS  AOOEO  *,I2,*TH  FILE  (*,A7,3A10,*)  TO  *,A7,*  FR 

•OH  *,A7,*  FILE.*) 

GO  TO  10 
90  CONTINUE 
C  DROP  AND  OROPB 
REHINO  4 
REMIND  40 

CALL  CPYFIL(4,40,NFIL£S) 

J=TOC(4, IFIlE) 

PRINT  9, IFILE, MOO E<J) , I  TOC ( I ( IFILE) ,1  =  1,3) ,FILNAM(4) 

J  =  T  OC (4, 2) -1 
TOC  (4,2) =J 

IFtJ.EQ.IFILE-1)  GO  TO  96 
DO  95  I=IFILE,J 
00  95  K=l,4 
TOC(K,I)=TOC(K,I*1) 

95  CONTINUE 

96  CONTINUE 

CALL  NEMFIL(NFILCS, TOC, IFILE, 0) 

LASTF=0 

NFILES=NFILES-1 

9  FORMAT {*  EmFLIB  SIS  DROPPED  *,I2,*TH  FILE  C*,A7,3A10,*)  FROM  *,A7, 

*».*) 

GO  TO  10 
100  CONTINUE 

C  TOC 

PRINT  11,FILNAK14) 

11  FORMAT  I*  EMPLI0  SSS  TABLE  OF  CONTENTS  OF  *,A7) 

DO  105  I=1,NFILES 
IF (I.EQ.2)  GO  TO  1C4 
K=TCC(4,I) 

PRINT  31,1, (TOC (J,I ) , J=l,3) , MODE (K) 

J1  FORMAT (I2U,4(10X,A10)) 

GO  TO  105 

104  CONTINUE 

PRINT  32, (TOC (J, I), U= 1,4) 

32  FORMAT (2OX,3(10X,A10) ,15,*  FILES  ON  LIBRARY*) 

105  CONTINUE 
GO  TO  10 

C  KEEP  AND  KEEPS 
110  K=FETS (5) 

J=2*IARCH 

IF(IARCH.NE.O)  GO  TO  120 
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1  =  0 

REMIND  6 

0  BUFFER  IN(5,1>  (A,A(2)> 

1=1*1 

IF (UNIT (5 ) )  130,126,2000 
5  1  =  0 

J=J*1 
GO  TO  120 

0  IF (LENGTH (5) . NE.ll  GO  TO  120 

IFIA(1).NE.LASTH>  GO  TO  120 
IARGH=J/2 

G  CALL  SKIP3(X(K)  ,1) 

CALL  P0SFIL(4,LASTF,IFILE) 

BUFFER  OUT (6,1)  CTOC(l, IFILE) , TOC (4, IFILE) ) 

IF(UNIT(5) .GE.0)  GO  TO  2010 

EN0FILE  5 

CALL  CPYFIL(4,6,1> 

LASTF=iriLE 

BUFFER  OUT (5, II  (LASTH,LASTH! 

IF (UNIT (5) ,GEa0«0>  GO  TO  2010 

BACKSPACE  6 

IARCH=IARCH*1 

1= I ARCH 

J=T0C(4, IFILE) 

PRINT  12, IFILE, MODE ( J) , (TOC (K, IFILE) ,K=1,3) ,FILNAN(4) ,FtLNAH(6) ,1, 
•FILNAH(6> 

FORMAT!*  EMPLIB  US  KEPT  *,I2,*TH  FILE  (»,A7,3A10,*>  FROM  *,A7,*  O 
*N  *,A7,*  FILE.*/I20,*  SOURCE  ANO  BINARY  FILES  NON  KEPT  ON  *,A7,*  F 
*ILE.*) 

GO  TO  10 
0  CONTINUE 
CREATE 

REMINO  4 

CALL  CPYFIL(4,40,1) 

CALL  NENFIL<l,TOC,O,0) 

REMIND  4 
LASTF=8 

PRINT  16,FILNAM(4)  ♦ 

FORMAT!*  EMPLIB  US  CREATEO  EMPLIB  ON  FILE  NAMED  *,A7,*.*> 

JTOC=0 
GO  TO  10 
0  CONTINUE 
FIND  AND  FINOB 
IARCH=0 
REMIND  5 
1=0 
M=1 

IF(JUMP.EQ.15)  M=2 
J=1 

O  BUFFER  IN (6,1)  (A,A(4)> 

1  =  1*1 

IF (UNIT(6) )  190,180,2020 
0  1  =  0 
J=J*1 
GO  TO  170 
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PROGRAM 


225 


233 


235 


253 


21*5 


250 


255 


253 


265 
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EMPLI8  CUC  6600  FTN  V3.0-P292  OPT=l  04 

190  L=LENGTH(5> 

IF(A(1J.NE.LASTH.0R.L.NE.1>  GO  TO  200 
PRINT  21,M0DE<M> .NAME, IVERS,FILNAM(5) 

21  FORMAT {•  EMPLIB  Sit  FILE  SOUGHT  <•, A7,2A10,*»  IS  NOT  ON  *,A7,*.*> 
IFLAG=1 

GO  TO  10 

200  If(L.N£.4J  GO  TO  170 

IF(M.NE.A(4).0R.NAM£.NE.A(1).0R.  IWERS.NE.AC2JI  GO  TO  170 
I=J/2*1 

PRINT  22,  I,MOOE(M>  ,A<1>  ,A<2)  ,A(3>  ,FILNAN(5> 

22  FORMAT (*  EHPLIB  SSS  *,I2,*TH  FILE  FOUND  (*,A7,3A10,*»  ON  *,A7,*.*> 
BUFFER  IN(5,1)  (A, A) 

IF(UNIT(5J.NE.0>  GO  TO  2020 

CALL  CPYFIL(S,M,0) 

PRINT  23,FILNAM(H) 

23  FORMAT (*  EMPLIB  SSS  COPIEO  FILE  FOUND  TO  *,A?,*.*> 

IARCH=I 

GO  TO  10 
210  CONTINUE 
C  HISTORY 

PRINT  25,FILNAH(5) 

25  FORMAT!*  EMPLIB  SIS  HISTORY  OF  *,A7» 

REWIND  5 

1  =  0 

220  1=1*1 

IARCH=I-1 

BUFFER  IN  (5,1)  (A,A(4>> 

IF (UNIT (5) •  GE.  0>  GO  TO  2030 

IF(LENGTH(51.N£.1.0R.A(1).NE.LASTH>  GO  TO  225 
BACKSPACE  5 
GO  TO  10 
225  CONTINUE 
K=A(4» 

PRINT  26,I,(A(J),J=1,3) , MODE  <KI 

26  F0RMAT(21X,*KEEP  NO.*, 14, 1JX,4A10> 

BUFFER  IN(5,1)  (A, A) 

IF (UNIT (5). NE .01  GO  TO  2030 
CALL  CPrFIL(5,0,ll 
GO  TO  220 
230  CONTINUE 
C  RENAME  AND  RENAMES 
REWIND  4 
REWIND  40 

CALL  CPYFIL(4,43,NFILES) 

CA(_L  N£MFIL(NFILES,TOC,Q,0) 

LASTF=0 

K=T0C(4,IFILE> 

PRINT  28,IFILE,N09E(K) , NAMOLO, IV0LD,T0C(3,IFILE> ,M0DE (K) , (TOC (I, IF 
•ILEl ,1=1,31 

28  FORMAT (•  EMPLIO  SSS  RENAMED  *,I2,*TH  FILE  (WAS  *,A7,3A10,*,  IS  NOW 
•  *,A7,3A10,*I.*I 
GO  TO  10 
240  CONTINUE 
C  REFUSE  ANO  SELECT 


275 


PROGRAM 


EHPLIB 
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IRS-1 

■5 

IFIIFILE.EQ.O)  CO  TO  245 

CALL  POSE XL!4,LASTF,1FILE) 

K=T0C(4,IFILE> 

280 

29 

PRINT  29,FILNAM!1) , IFILE, NODE (K) , (TOCII.XFILE) ,1=1,3) ,FILNAH(4> 

FORMAT !•  EMPLIB  SSS  COPYING  THE  FCLLOHINS  BINARY  RECOROS  ONTO  *»A7 

| 

*,*  FROM  THE  *, I2,*TH  FILE  !*,A7,3A10,*)  ON  *,A?,*.*//45X,*SELECTE0 
**,7X,*REFUSE0*/> 

| 

K=NREC 

1 

285 

245 

IF(JUMP.£Q.20)  K=-K 

CALL  CPYREC(4,1,NAMREC,K> 

LASTF=IFILE 

GO  TO  10 

CONTINUE 

I 

290 

36 

PRINT  36,FILNAH(1),FILNAH(3> 

FORMAT!*  EMPLIB  SSS  COPYING  THE  FOLLOWING  BINARY  RECORDS  ONTO  »,A7 

*,*  FROM  *,A7*.*//45X, 'SELECTED*, 7X,*REFUSE0*/> 

K=NREC 

IFUUMP.EQ.20)  K=-K 

295 

250 

CALL  CPYR£C(3,1,NAHREC ,X) 

GO  TO  10 

CONTINUE 

c 

NOREUINO 

NOR£H=l 

f 

300 

260 

GO  TO  10 

CONTINUE 

C 

SKIP  ANO  SK1PB 

-■  - 

1  =  8 

IF(JUHP.£a.26>  1=3 

ii 

■ii 

335 

33 

CALL  CPYFIL(I,0,IFILE> 

PRINT  33,IFILE,FILNAM(I) 

FORMAT!*  EMPLIB  SSS  SKIPPED*, 14,*  FILES  ON  *,A7,*.*I 

GO  TO  10 

. ; 

‘I 

< 

270 

CONTINUE 

A 

310 

C 

CREATEARCH 

7i 

REMIND  5 

IARCH=Q 

A«1»=4HLAST 

BUFFER  OUT !5, 1)  !A,A) 

| 

> 

3 

1 

315 

35 

IF!UNIT!5) .GE.0.0)  GO  TO  2010 

REMIND  5 

PRINT  3S,FILNAMI5> 

FORMAT!*  EMPLIB  SSS  CREATED  .KCHIVE  ON  FILE  NAMED  *,A7,*,») 

GO  TO  10 

5 

A 

A 

329 

280 

CONTINUE 

| 

C 

REPLACE  and  replaces 

l=shreplaceo 

GO  TO  75 

| 

1009  CONTINUE 

-- 

325 

34 

N=LNAX-1 

IFIIRS.NE.O)  PRINT  34,MX,M 

FORMAT l*0EMPL IB  SSS  MAXIMUM  RECORD  LENGTH  PROCESSED  FOR  SELECT-REF 

•USE  MAS*, 15, *.*,16,*  IS  MAXIMUM  ALLOWED.*) 

IF IIFLAG.EQ.O)  PRINT  13 

330 

13 

FORMAT !*0Em,*lIH  SSS  FINISHED  SSS*) 

29 


PROGRAM 


EHPLI8 
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REMIND  4 
00  1010  J  =  l,2 
I=F£TSSJ> 

IFSSXSI>.AN0.50«).N£.20>  GO  TO  1010 

ENOFILE  J 

CALL  SKIPBSXSI) jO) 

1010  CONTINUE 

IFCIFLAG.EQ.O)  STOP 
PRINT  18 

18  FORMA TS’OEMPL IB  SIS  ABORTING  SSS>) 

CALL  ABORT 
2000  CONTINUE 

PRINT  14,I,J,FILNAMS5» 

14  FORMAT  I*  EMPLIB  Sit  KEEP  REAO  PARITY  ERROR  ON*,IS,*TH  RECORD  ON*, I 
*3,*TH  FILE  ON  *,A7,*.*> 

CALL  ABORT 
2310  CONTINUE 

PRINT  15,FILNAMS5> 

15  FORMATS*  EMPLIB  SIS  KEEP  WRITE  PARITY  ERROR  ON  *,A7,*.*> 

CALL  ABORT 

2020  CONTINUE 

PRINT  24.FILNAMS5) 

24  FORMATS*  EMPLIB  SSS  FIND  REAO  ERROR  ON  *,A7,*.*> 

CALL  ABORT 
2330  CONTINUE 

PRINT  27,FILNAH(5> 

27  FORMATS*  EMPLIB  SSS  HISTORY  REAO  ERROR  ON  *,  A7,*.*> 

CALL  ABORT 


|  SUBROUTINE  GETTOCtTOC.NFILES.JCRI 

t  OZMENSION  TQC(N»50> 

[  REKINO  N 

|  JCR=0 

5  CALL  CPYFIL  (<■ .  0,1) 

BUFFER  IN(Nyl)  <TOC,TOCU,50>) 

1  1F(UNIT<N>>  10.20,100 

■  10  NFILES-LENGTHINJ/N 

RFTURN 

?  10  20  NFILES=2 

■  JCR=1 

RETURN 

100  PRINT  1 

,  1  FORNATC*  EMPLie  <tt  GETTOC  PARITY  ERROR* 1 

j  15  CALL  ABORT 

>  END 


SUBROUTINE  CPYFIL 


CQC  6600  FTN  V3.0-P270  OPT  =  l 


0) 


10 


15 


20 


25 


30 


35 


60 


65 


10 


20 


30 


35 


36 


60 


200 


300 


600 


SUBROUTINE  CFYFILCIIN,I0UT,NF1 
COMMON  //LMAX, A  (ll 

COMMON  /FILfcS/FILNAH<91 .FETSC91 ,X( 1J 
INTEGER  FILNAM,F£TS,X 
IFCICUT.GT.01  GO  TO  30 
DO  20  1  =  1, NF' 

BUFFER  INCIIN.15  (A, A) 

IF(UMT  ( IIN)  »  10,20,200 

CONTINUE 

RETURN 

CONTINUE 

LMX=512*CL«AX/5121 

JIN=MIN0C9,IIM 

JOUT=HINO(9,IOL'T1 

J=F£TS(JIn> 

K=F£TSC JCUTI 
03  60  1=1, NF 
CONTINUE 

CALL  CPY8UF :A,ACLMx»2> ,XCJ) ,XCK1 ,IERl 
IFIIEfi.NE.il  GC  TO  36 
IFCI.NE.11  GO  TO  61)0 
PRINT  3,FILNAM(IIN1 

■m!l*E&LKPMMT?5r::;7**  lNlmtLr  PCSITICNEC  «  enc,-of-infcr«at 

CALL  ABORT 
CONTINUE 

IFCIER.NE.01  GC  TO  300 

IFCNF.GT.01  FNGFILF  IOUT 

CONTINUE 

RETURN 

CONTINUE 

PRINT  1,1 ,F ILNAMC JIN1 

•'SEsvsjr  s‘.sw.r  ■"»» 

CALL  A3CRT 
CONTINUE 

PRINT  c.FILNAMCJIWI  ,HLNflH<JOUTI  ,I,I£R 

FORMAT ( *  tHPLIfi  SSI  I/O  CRROR  IN  CPY0UF  NHILE  COPYING  *Tr  •  A 

*T,»,  FILE  NUMBER*, I3/20X..ERROR  COOE  IN  CCm  lf”c2ni  ’  ’ 

CALI  AlJCfcT 
CONTINUE 

PRINT  S.FILNAMCJINl ,I,NF 

»fnF.*ri*«e2?!‘lf  ??*  CNO-OF-INFORMATION  ENCOUNTEREC  COPYING*,  13, »TH 
OF*, 13,"  FILES  CFROM  START  OF  CCPY!  ON  »,A7,».*1 
CALL  AflCRT  ’ 

FNC 


32 


SUBROUTINE  GETFIL 
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SUBROUTINE  GFTFIL 

COHNCN  /FILES/FI!,NAH(9)  * FETSC9)  *  X<  1) 
INTEGER  FI<.NAH*FETS»X 
OAT*  NASK/777777Q/ 

L=LOCMX> 

00  10  1=1*9 
J=Z-L*I 

FILNAHCI)=XCJ> 

J=FILNAH(I) .AND. MASK 
FETSCI)=J-L*1 
10  CONTINUE 
RETURN 
END 


a 


S3 


- . SUM . . . . . . . . . . . . . . . . * . I . I . II . .  . . . . 


t 


SUdROUTINE  SHAPE II 
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A 


ID 


IS 


20 


25 


30 


35 


SO 


10 


20 

30 


SO 

2 


SUGRGUT INE  SWAPFIL < IUNIT .NAME) 

OIHESSICS  KCRC1CS) .K0R02C9) 

COMMON  /FILES/FILNAM<9>,FETS(9),Xtl) 

INTEGER  FILNAM.FETS.X 

OAT  A  HORCI/IOHOINARY  OUT, 1 OHSOURCE  OUT .IOhBINARY  INP.10HEMP  U1QRAR 
'.lOHARCKlVE  KE.10HEHPL1U  INP.10HEMPLI3  OUT , 10HS0URCE  INP/ .H0RC2/3H 
•HUT.3HPUT.3HUT  ,3HV  ,3HEP  ,3HUT  , 3HPUT.3HUT  / 

OAT A  KASKDT/777700 00 OOQQO 000 00003/ .MASK/ 777777B/.MASKCH/778/, 18/ 1H 
•  / 

I-FETSI IUNIT) 

II=X(I*1> 

kflag=o 

IF<(II. ANTI. MASKOT).FQ.O.ANU.<XII»S). AND. .NOT. MASK). EQ.O)  GO  TO  10 
KFLAG=1 

IN=X<I).AN0.509 

CHECK  TO  SEE  IF  LAST  OPERATION  HAS  AN  FOR  HRITE. 

IF (IN.NE.20)  GO  TO  5 
ENOFILE  1UNIT 
CALL  SKIFS(Xd) ,0) 

CONTINUE 

X(IA1)~X(IA1) .AND. .NOT .MASKOT 
Xd*S)  =  Xd*S).  AND.  MASK 
CONTINUE 
IN~NAh£ 

00  20  J=S , 1 0 

M=SHIFT (MASKCH ,6»<J-1) I 

;F<(IN.AN0.M).NE.(IB.AN0.M)I  GO  TO  30 

IN=IN.AhO. .NOT  «M 

CONTINUE 

CONTINUE 

XT I» =1 IN. AND.. NOT. MASK). OR. 3 
IsFILNAM(IUNIT) 

FILNAM(IUNIT)=IN 
IF(KFLAG.GT.O)  GO  TO  SO 

PRINT  1,N0R01<IUNIT),H0R02CIUNIT),FILNAM«IUMT» 

FORMAT  I*  EMPLI6  ASS  HAUL  •fA10,A3,»  FILE  •,A7,».») 

RETURN 

PRINT  2,N0RC1(IUNIT),M0R02(IUHIT),FILNAMIIUNIT) ,1 


FORMAT!*  EMPLIB  Ht  MAOE  »,A10,A3,«  FILE 
“1 

RETURN 

END 


*,A7,»  INSTEAD  OF  *,A7»*. 


. . . . . . . . . . . . . . . 
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IOENT  SKIPS 
ENTRY  SKIPS 


EXT 

CPC 

VFO 

30/5HSKIPB,30/1 

SKIPS 

ess 

1 

SX7 

AO 

SA7 

SAVAO 

SA2 

A141 

SA< 

X2 

SA1 

XI 

NZ 

X3, SKIPFIL 

RJ 

CPC 

VFO 

18/3, 2/1, 22/1, 18/640e 

EQ 

RET 

SKIPFIL 

SA4 

ARG 

LX3 

IS 

BX6 

X34X4 

SA6 

ARGLOC 

RJ 

CPC 

ARGLOC 

8SS 

1 

RET 

SAS 

SAVAO 

SAO 

xs 

EQ 

SKIPS 

SAVAO 

BSS 

1 

ARG 

VFO 

16/3,2/1,22/0,4/178,14/6408 

ENO 

STORAGE  USEO 
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CCPPASS  -  VER  2.  01/18/72  11.12.50. 


IOENT  CPYUUF 
ENTRY  CPYfiUF 
VFO  3£/6HCFY8UF,2%/5 
8SS  1 
SB7  1 
SCb  87*87 
SA2  A1»B7 
SA3  Al*86 
SAA  A2*B6 
SAB  A3*36 
SX6  AO 
SA6  AZERO 
3X7  X5 
SA7  IER 
HX7  0 
SA7  X5 
SA7  FLAG 
BX6  XI 
SA6  BOUNDS 
BX7  X2 
SA7  A6*B7 
SA1  X3*87 
SA2  Al*37 
8X6  XI 
8X7  X2 
SA1  A2*87 
SA2  Al*87 
SA6  SAVE 
SA7  A6*B7 
8X6  XI 
8X7  X2 
SA6  A7*B7 
SA7  A6*B7 
SA1  XA107 
SAC  Al*B7 
ex6  XI 
3X7  X2 
SA1  A2*87 
SA2  Al*97 
SA6  A7*87 
SA7  A6*B7 
BX6  XI 
8X7  X2 
SA6  A7+87 
SA7  A6*B7 
SA1  BOUNDS 
SB2  XI 
SA2  Al«B7 
SB1  X2 
SAl  X3*B7 
NX  0  52 
SX7  02 
0X6  X1»X0 
8X6  X6*X7 
SA6  X3*07 
SA7  A6*87 
SA7  A7*87 


X3  TO  CONTAIN  ACCRESS  OF  FILEIN 
XA  SAHE  FOR  FILECUT 


COMPASS  -  VER  2.  01/18/72  11.12.50. 


SA1 

SX2 

BX6 

3X7 

SA7 

SX1 

SA2 

3X6 

3X7 

SA7 

SA1 

3X6 

SA6 

RECALL  SA5 
NZ 
SA1 

sxo 

8X2 

ZR 

SXO 

8X2 

NZ 

SA5 

8X6 

SA6 

EO 

FOI  SX2 

HXO 
8X6 
8X6 
SA6 
SA2 
NZ 
SX6 
SA2 
SA6 
EQ 

CK  SXO 

8X7 
SXO 
1X6 
ZR 
SA1 
SA2 
HXO 
8X6 
0X7 
8X7 
SA7 
SA1 
BX6 
SA6 
SA2 
3X7 
SA7 
SA1 
SA2 


Al*3 

81 

X1»X0 

X6+X2 

A7*B7 

128 

X3 

X0*X2 

X6*X1 

X3 

CIOHORO 
X1  +  X3 
87 
87 

X5|RECALL 

X3 

370008 

X1»X0 

X2.0K 

30008 

X1»X0 

X2.E0I 

IER 

XI 

X5 

RETURN 
7 %00338 
62 

X0»X1 

X6*X2 

X3 

FLAG 

X2, RETURN 

B7 

XER 

X2 

RETURN 
778 
X0»X1 
338 
X7-X0 
X6, RETURN 
X3»87 
X6*87 
62 

-X0»X1 

X0»X2 

X6»X7 

A2 

Al»87 

XI 

A7*87 
A1  +  B7 
X2 

A6*67 
A2»B7 
A*  *97 


e  n 


CCHPASS  -  VER  2. 


01/18/72  11.12.50. 


8X6 

-X0*X1 

8X7 

X0*X2 

8X7 

X6+X7 

SA7 

A2 

SX6 

87 

SA7 

FLAG 

SA1 

X] 

SA2 

XL 

S83 

XI 

SX6 

83*3 

8X7 

X0*X2 

8X7 

X6+X7 

SA7 

XL 

SA1 

CIOHORD 

8X6 

Xl+XL 

SA6 

87 

RECALLA 

SA5 

87 

NZ 

X5t RECALLA 

SA1 

XL 

SXO 

370008 

8X2 

X1»X0 

2R 

X2,0KA 

S15 

IER 

8X6 

XI 

SA6 

X5 

EQ 

RETURN 

OKA 

SB1 

-378 

S82 

XUB1 

NE 

82, LOOP 

RETURN 

SA1 

SAVE 

SA2 

A1*B7 

MXO 

L2 

SA5 

X3LB7 

8X6 

-X0*X1 

8X5 

X0*X5 

8X6 

X6*X5 

8X7 

X2 

SA1 

A2*B7 

SAZ 

Al»B7 

SA5 

X3*L 

SA6 

X3*97 

SA7 

A6  +  B7 

8X6 

XI 

8X7 

-X0»X2 

ex5 

X0»X5 

8X7 

X7*XS 

SA6 

A7*87 

SA7 

A6*B7 

SA1 

A2*B7 

SA2 

A1LB7 

SA5 

XL*8/ 

8X6 

-X0*X1 

8X5 

X0*X5 

8X6 

X6LX5 

8X7 

X2 

SA1 

A2»87 

SA2 

A1,B7 

38 


JUSOM 


5 


YS 


£ 


'M 


«IRIW^  t>  WWWWWTjTOMjn!  •'f'li'it  mrmm  *«•  »  wm« 


IER 

A2ER0 

60UN0S 

FLAG 

SAVE 


SAS  X6*4 

SA6  Xk*BT 
SA7  A6*87 
6X6  XI 
6X7  -X0»X2 
6X5  X0»X5 
6X7  X7»X5 
SA6  A7»87 
SA7  A6»87 
SA1  AZERO 
SAD  XI 
EQ  CPYBUF 
6SS  1 

ess  i 
ess  z 
ess  l 

BSS  8 


CiOHORO  VFO  18/3HCI0, 2/1, 60/0 


END 

STORAGE  USED  190  STATEMENTS 
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SUBROUTINE  NENFIl 


COC  6600  FIN  V3.0-P220  OP1=l  01 


5 


10 


15 


20 


25 


SUBROUTINE  NEHFIL t NFILES ,TOC , IFILE , J1 
DIMENSION  TOC<«<  ,NFILES) 

REHIND  <t 
REhINO  40 
L=MAX0t2,NFIL£Sl 
K=L 

IFUFILE.NE.0.AND.J.EQ.01  K=K-1 
00  30  1=1, t 
IFtI.KE.21  GO  TO  10 
BUFFER  OUT  <4,11  ( TOC,TOC(4 ,K> 1 
IFtUMTt4l.GE.C.01  GO  TO  100 
ENOFILE  4 

IFtNFILES.NE.il  CALL  CPTFILt 40, 0, 1 1 
GO  TC  30 

10  IFf I.NE.IFILE1  GO  TO  20 

IFtNFILES.NE.IFILEl  CALL  CPYFIL t40 , 0, 1 1 
IFtJ.KE.OI  CALL  CPYFIL(J,4,11 
GO  TC  30 

20  CALL  C.jYFIL  (40,4,11 

30  CONTINUE 

REHINO  4 
RETURN 

100  CONTINUE 

PRINT  1 

1  FORMAT  t*  EKPIIB  US  TOC  HRITE  PARITY  ERROR  IN  NEHFIL.*! 

CALL  ABORT 
END 
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SUBROUTINE  ISIT(CHAR,CARD,NCHAR, JUMP, IFILE»TOC»ODATE, JCR.FILNAM) 
COHMON  /ARGS/NANE,IVERS,NAHOLO,IVOLO,NREC,NAKREC(100>,JTOC,LASTF, 
'IARCH 

INTEGER  FILTYP(S) ,NTYP(8> 

S  INTEGER  FILNAM(l) 

DIMENSION  CARD (79) , TOC (A. 1> ,CHAR(1> 

OIHENSION  HODEH (2 ) 

DIMENSION  NUHS(IO) 

INTEGER  CARO, TOC, OOATE ,CHAR 

10  DATA  FILTYP/2He0,2H9I,2HS0,2HSI,lHL,lHA,lH0,lHl/,NTYP/l,3-2,8,4,S, 

'7,6/ 

OATA  IB/1H  /, MASK/770/ 

DATA  M00EH/6HS0URCE,6KDINARY/ 

OATA  NUMS/1H0,1H1,1H2,1H3,1H4,1H5,1H6, 1H7,1H8,1H9/ 

IS  JUMP=0 

NAME=I8 
1ST =1 

CALL  NEXTHDICARO, 1ST, NAME, JFLAG) 

IF(JFLAG.EQ.O)  GO  TO  1G 
20  PRINT  l,CARO 

1  FORMAT (*  EMPLIS  SSS  IMPROPER  DIRECTIVE  ON  CARO. '♦.79A1I 

10  CONTINUE 

DO  40  JUHP=1 , NCHAR 
IFICHARC JUMP) .E3.NAMF)  GO  TO  SO 
25  40  CONTINUE 

PRINT  2,NAHE,CAR0 

2  FORMAT(*  EMPLIB  SSS  UNRECOGNIZABLE  DIRECTIVE. A10,»'*,79A1> 

JUMP=0 

RETURN 

33  SO  CONTINUE 

IFUUMP.EQ.27)  RETURN 
IFCJUMP.EQ.13)  GO  TO  330 
IF ( JUMP.EQ.21)  GO  TO  000 
IF (JCR.EQ.O)  GO  TO  S5 

3S  IF( JUMP.GE.13. AND. JUMP.NE.17.AND. JUMP.NE. 19)  GO  TO  5S 

JUMP=0 

PRINT  7, NAME 

7  FORMAT (*  EMPLIB  SSS  OIRECTIVE  REQUIRES  TABLE  OF  CONTENTS,  WHICH  HA 
'S  NOT  BEEN  CREATED. **,A10) 

43  RETURN 

55  IF (JUMP.EQ.10 .OR. JUMP. SQ.16)  RETURN 

IF (JUMP.EQ.24)  RETURN 
IF( JUMP.EQ.25.OR. JUMP.EQ.26)  GO  TO  800 
IF ( JUMP. £ 3. 22  - OR. JUMP. EQ. 23)  GO  '0  700 
45  NAME3 IB 

CALL  NEXT HO (CARO, 1ST, NAME, JFLAG) 

IF (JFLAG. NE. 1. OR. (JUMP.NE. 19. ANO. JUMP.NE. 20) )  GO  TO  56 

IFILE=0 

GO  TO  630 

50  56  CONTINUE 

IF(JFLAG)  70,80,60 
60  CONTINUE 

PRINT  3, NAME, CARO 

3  FORMAT (*  EMPLIB  SIS  CANNOT  FI  '0  PROGRAM  NAME  ON  CARO. '*,7981) 

55  JUMP=0 
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RETURN 

70  CONTINUE 

PRINT  4, NAME, CARO 

4  FORKATt*  ENPLI8  SSS  PROGRAH  NAME  TOO  LOtlG.  •*,A10,*,*,79A1> 

JUMP=0 

RETURN 

AO  CONTINUE 

?VERS=i9 

CALL  NCXTNDtCAROy  1ST,  IVERSy  JFI.AG) 

IF(JFLAG.GE.O)  GO  TO  103 
PRINT  SylVERSyCARD 

5  FORMAT  I*  EMPLI3  SiS  VERSION  NAME  TOO  LONG.  **  ,  AID  ,  *  **  ,  T'ill) 

JUMP=0 

RETURN 

100  CONTINUE 

IFtJFLAG. EQ.il  IST=IST-1 

IF (JUMP. E 0.14. OR. JUMP. EQ.15J  RETURN 

N=T0C(4,2) 

MOOE-l 

TFtJUHP.EQ.29)  N00E=2 

IF(JUHP.£Q.3.0R*  JUMP. EQ.5. OR.  JUMP. EQ.9S  riOOE  =  2 

IF t JUMP. EQ. 1. OR. JUMP. EQ. 7. OR. JUMP. EQ. 12. OR. (JUMP. GE. 10. AND. JUMP.  LE 
*.20»»  MODE=? 

00  163  IFIL£=1.N 

IF(TQCt4,IFILE) .EQ.NOOE.ANC.TOCtl,IFILE).£Q.NAME.4ND.TOCC2,IFILE>. 
•EQ.IVERS)  GO  TO  170 

IF(JUMP,N£.1.0R.TOC<4.  IFILE3  .NE,  MODE. OR. TOC  tl,  IFILE)  .:*£. NAME)  GO  T 
*0  160 
C  Run 

lV£RS-TOC(2tIFILE> 

RETURN 

160  CONTINUE 

IFtJUMP. EQ.6.0R.JUHP.EQ.7)  GO  TO  100 
PRINT  6,NAH£,tVERS 

6  FORMATt*  EMPLIB  tSS  *,2A10,*  NOT  IN  TOC.*) 

JUMP=0 

RETURN  * 

170  CONTINUE 

IF (JUMP.EQ.6.0R. JUMP.EQ. 7)  GO  TO  10S 
C  RUN,  COPT ,  COPYB,  KEEP,  AND  REEP8 

IFt JUMP. EQ.l. OR. JUMP.EQ.2.0R.JUMF.EQ. 3. OR. JUHP.EO.il. OR. JUMP. EQ.12 
M  RETURN 

IFtJUMP. NE. 4. ANO. JUMP. NE. 5)  GO  TO  190 
C  CHANGE  ANO  CHANGES 
RETURN 

100  CONTINUE 
C  AOO  ANO  A 308 

IFILE-TQCt4,2)*l 

T0C(4,2)=IFILE 

TOC (I, IFILE) =NAHE 

T0C(2,IFILE)=IVERS 

TOCf 3, IFILE) =OCATE 

T0C(4,IFILE)=JUMP-5 

RETURN 

105  CONTINUE 
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J=T0C(4,1FILEI 

PRINT  11, IFIL£,HOO£H( Jl , (TOC ( I > I PILE) ,1=1,3) 

11  FORMAT  <»  EMPLIB  *J$  ADDING  FILE  ALREADY  IN  TOC  IS  NOT  PERHITTEO.  * 
*•  FILE  IS  »,I2,*  FILE  (•,A7,3A10,»».*1 

JUMP=0 

RETURN 

190  IF(JUNP.N£.8.ANO.JUMP.I-E.91  GO  TO  210 
C  DROP  AND  0R0P3 

IF(IFILS.GT.21  RETURN 
PRINT  8 

3  FORMAT <*  EMPLIB  ttt  DROPPING  LIBRARIAN  OR  TABLE  OF  CONTENTS  IS  NOT 
•  PERMITTED. •> 

JUHP=0 

RETURN 

310  IF ( JUMP.NE.17.AN0. JUMP.NE. 18)  GO  TO  600 

C  RENAME  ANO  RENAMES 

CALL  NEXTWDTCARD, 1ST, NAME,  iFLAGl 
IF(JFLAG.EQ.l)  go  TO  220 
216  PRINT  12, CARD 

12  FORMAT (•  EMPLIO  tit  MISSING  COMMA. *»,79A1> 

JUMP=0 

RETURN 

220  NAN£=I8 

CALL  NEXTMO(CARO,IST,NAME,JFLAG> 

IF(JFLAG)  230,290,240 
230  FRINT  4, NAME, CARO 
JUHP=ii 
RETURN 

240  PRINT  3, NAME, CARO 
JUMP=0 
RETURN 

250  IVERS-IB 

CALL  NEXTM0(CAK0,IST,IVERS,JFLAG> 

IFTJFLAG.GE.J1  GO  TO  26:' 

255  PRINT  5,1  VERS, CARO 
JUMP=0 
RETURN 

260  CONTINUE 

NAHOLO=TOC (1.IFILE1 
IV0L0=T0CC2,IFILE1 
TOC(l,If ILE1=NAME 
T0C12,IFILE1=IVERS 
RETURN 

Jill-  CONTINUE 
C  CREATE 

TOC(l,21=3HTOC 

T0C(2, 21=19 

TOC (3,21 =OOATE 

TOC (4,21=2 

T0C(l,il=6HENPLI8 

T0C(2,11=T9 

TOC(3,11=OOATE 

T0C(4,11=2 

JCR=0 

RETURN 
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500  CONTINUE 
C  FILES 

510  CALL  NEXTMO (CARD, 1ST, NAME. JFLAG) 

IF (JFLAG.  EQ.2)  RETURN 
IF( JFLAG)  520,530,510 
520  PRINT  13, NANS, CARO 

13  FORMAT (*  ENPLIB  S (S  HORO  IS  TOO  LONG. '*,A10,*»79A1) 

JUNP=0 

RETURN 

530  CONTINUE 

00  560  1=1,8 

IF (NAME.EU.FILTYP(I) )  GO  TO  550 
S4C  CONTINUE 

PRINT  14,NAME,FILTYP 

14  FORMAT!*  EMPLIB  SSS  FILE  TYPE  *,A10,*  IS  NOT  ONE  OF  THE  ALLOWED  FO 
»RHS  *,8A3,*.*> 

JUMP=0 

RETURN 

550  IFILE=NTYP(I) 

CALL  NEXTMO (CARO, 1ST, NAME, JFLAG) 

JF (JFLAG)  520,560,560 
560  CALL  SMAPFIL(IFILE,NAME) 

IF(IFILE.NE.4.AND.IFILE.NE.5)  GO  TO  510 
IF ( IFILE. EQ.4)  GO  TO  570 
REWINO  5 
IARCH=0 
GO  TO  510 
570  REMIND  4 
LASTF=0 
JT0C=0 
GO  TO  510 
630  CONTINUE 
C  REFUSE  AND  SELECT 

IFMUHP.NE.19.AN0.JUHP.NE.20)  GO  TO  700 

NRtC-  =  0 

kflag=c 

610  CALL  NEXTM0(CAR0,1ST,KANE,JFLAG) 

IF (JFLAG. EQ.2)  GO  TO  640 
IF (JFLAG)  520,620,630 
620  NREC=NREC*1 

IF(NREC.GT.IOO)  GO  TO  650 
NAHREC  (NREl.)  =NAME 
KFLAG=0 
GO  TO  610 
630  KFLAG=1 

GO  TO  610 

660  IF(KFLAG.EQ.G)  RETURN 
RE *0  15, CARO 

15  FORMAT (79A1) 

PRINT  16, CARO 

16  FORMAT (IX, 7 9A1) 

KFLAG=0 

IST=1 
GO  TO  610 
650  PRINT  17 
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225 


233 


235 


241 


245 


253 


255 


263 


265 


220 


12  FORMAT t*  EMPLIB  Si*  MORE  THAN  100  RECORD  NAMES  GIVEN  —  TOO  MANY.* 

') 

JUMP-3 

RETURN 

230  CONTINUE 

IFtJUMP.NE.22.AN0.JUHP.NE.23)  GO  TO  930 
C  REWINO  ANO  ENOFILE 
NANE=I8 

CAUL  NEXT  HO (CARO, 1ST , NAME, JFL AG) 

IFIJFLAG.EQ.Q)  GO  TO  210 
PRINT  18, NAME, CARO 

18  FORMAT  1*  EMPLIB  SiS  ILLEGAL  FILE  TYPE. »♦, A10,»**,79A1> 

JUMP=0 

RETURN 

210  DO  223  1=1,8 

IF(NAME.Ea.FlLTYPU)  J  GO  TO  730 
720  CONTINUE 

PRINT  14,NAM£,FILTYP 
JUNP=0 
RETURN 
730  J=I 

I=NTYP(I) 

IFtJUMP.E0.23)  GO  TO  750 

IFU.NE.6.AN0.I.NE.7.AN0.I.NE.4)  GO  TO  743 
735  PRINT  19,CHARt JUMP) ,FILTYPt J) 

19  FORMAT!*  EMPLIB  tit  *,810,*  IS  AN  ILLEGAL  DIRECTIVE  FOR  THE  FILE  T 
*YPE  •,A2,*.») 

JUMP: 3 
RETURN 

740  REHINO  I 

NAME-7HRE MOUND 

745  PRINT  23,NAME,FILTYP(J),FILNAN(I> 

20  FORMAT t*  EMPLIB  Sit  •, A9*A2,*  FILE  NAMED  •fA7,*.») 

RETURN 

750  IFtI.NE.l.ANO.I.NE.2)  GO  TO  735 
ENOFILE  I 
NAME=8HENOFILEO 
GO  TO  745 
300  CONTINUE 
C  SKIP  ANO  SKIPS 

CALL  N£XTNO(CARO,IST,NAME,JFLAG> 

IF tJFLAG. NE.2)  GO  TO  810 

IFILE=1 

RETURN 

810  IF (JFLAG.EQ.O)  GO  TO  820 
PRINT  21, NAME 

21  FORMAT t*  EMPLIB  SIS  ILLEGAL  NUMBER.  •*,M0) 

JUMP=0 

RETURN 
8,0  IFILE=0 

I=SHIFT (MASK, 54) 

00  853  J=l,3 
L=I. ANO. NAME 

IFtL.EQ.tI.ANO.IO))  RETURN 
00  833  K=l,10 
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IF<L.EQ.(I.AN0.SHIFT<NUNSCKI,66-&»Jii)  GO  TO  860 
830  CONTINUE 

PRINT  21,  NAME 

JUHPsQ 

RFTI1BN 

860  IFIL£=10*IFIL£+K-1 
850  I=SHIFT<I,56I 
RETURN 

900  CONTINUE 
C  REPLACE  AN0  REPLACES 

NANQLO=TOC (1, IFILEI 

IVOLO-TOC (2, IFILEI 

CALL  NEXTNO(CARO, IST.NAHE, JFLAGI 

IFIJFLAG.NE.il  GO  TO  215 

NAHE=IB 

CALL  NEXT HO (CARO, 1ST, NAME, JFLAGI 
IF(JFLAG) 230,920,260 
920  I VERS=IB 

CALL  NEXTNOICARO, 1ST, IVERS, JFLAGI 
IF( JFLAG.LT . 01  GO  TO  255 
GO  TO  260 


SUBROUTINE  NEXTMO 


COC  6600  FIN  V3.0-P270  0PT=1  01 


5 


10 


IS 


?0 


25 


SUBROUTINE  NtXTHOTCARO,  1ST, NAME ,JFUG> 

INTEGER  CAROCU 

C  JFLAG=-1  IS  ERPOR,  0  IS  NORMAL  RETURN,  1  IS  COMMA,  2  IS  EMPTY  CARO 
NAME  =  1H 
JFLAG=? 

IFUST.GI.79)  RETURN 
00  10  I=IST,79 
IFTCAROTIJ .EC.1H,)  GO  TO  40 
IFTCAROTIJ .EC.1H.)  GO  TO  IS 
IF(CAR0(1).NF.1H  )  GO  TO  20 
10  CONTINUE 
15  IST=80 
RETURN 
20  1=1-1 

JFLAG=0 
or  30  J=l,ll 
IS!=J*I 

IF11SI.GT.79I  RETURN 
IF{CARC{ISTJ.£C.1H,I  RETURN 
IFTCAR01ISTJ.fC.lH  J  RETURN 
IFTJ.LT. 11)  CALL  ARPENOTJ.CAROUST)  ,NAHE) 

30  CONTINUE 

JFLAG=-1 
RETURN 

40  IST=I»1 

JFLAG=1 
RETURN 
END 
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SUBROUTINE  AFPENDT I fCHARf X) 
DATA  HASK/778/ 

ITE«P  =  SHIFTCHASK,60-6»U 

JT£NF=SHIFT<CHAR,6-6»I1 

JTeS?=II£HP.ANC.JTEMP 

X=X.ANO..NOT.iT£HP 

X=X.OR.JTENP 

RETURN 

£NO 
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SUBROUTINE  CPYREC( IIN, IOUT .NAMREC , NREC) 
COMMON  /MXC/MX 
COMMON  //UMAX, Ad! 

OIMGNSICN  NAhRECdl 
INTEGER  A 

DATA  HASK/778/,IB/lH  / 

N=IA£S (NREC1 
10  CONTINUE 

SUFFER  IMIIN.ll  ( A , ATLMAX!  1 
IF (UNIT C IIN))  30,20,101- 
2C  PRINT  1 

1  FORMAT C50X,*-ENO  OF  C0PT-*> 

RETURN 

30  L=LENGTHdIN! 

IFCU.EC.O)  GO  TO  90 

MX=HAXO<MX,L! 

ix=ie 

00  AO  1=1,7 
H=SHlFTtHASK, 60-6*1! 

IFdAI2!.ANO.H!.EO.O)  GO  TO  SO 
IX=dX.ANO..NOT.MJ .OR. f A 12). AND. Ml 
AO  CONTINUE 

50  00  80  1=1, N 

IFdX.EQ.NAMRECdl. AND. NREC. LT.01  GO  TO  60 
IFdX.EQ.NAMRECdl. AND. NREC. GT. 01  GO  TC  70 
IFJ I.EO.N.ANO.NREC.GT.Ol  GO  TO  60 
IFd.EQ.NI  GO  TO  70 
GO  TC  80 

60  BUFFER  OUT (ICUT , 1)  <A,A(L)> 

IFTUNITdOUTl.GE.O!  GO  TO  110 
PRINT  2, IX 

2  FORMAT JA5X,A71 

GO  TC  10 

70  PRINT  3, IX 

3  FORMAT (60X.A71 
GO  TC  10 

80  CONTINUE 

GO  TO  10 
90  CONTINUE 

PRINT  6 

6  FORHATt60X,*EMFTY  RECORD  ENCOUNTERED*! 

GO  TO  10 

100  PRINT  A 

A  FORMAT  I*  ENPLIB  f«  RE  AO  ERROR  IN  CPYREC.*! 

CALC  ABORT 
110  POINT  5 

5  FORMAT!*  ENPLIE  SSS  MRITE  ERROR  IN  CPYREC.*! 

CAUL  ABORT 
END 


